perm filename NSCTPY.F4[SYS,MUS]1 blob
sn#010342 filedate 1975-08-20 generic text, type T, neo UTF8
SUBROUTINE SEG(FUNC)
C TYPE AMPL, STEP# (UP TO STEP 512). ---- SAME FORMAT AS GEN 1 IN MUSIC5.
DIMENSION FUNC(512),A(4),MJ(6),MSG1(4)
COMMON K,STEP,AMP1,AMP2,DIF,IT,IS,ST,STPS,RK
DATA (A(K),K=1,3)/'SEG ARRAY FULL/'/
DATA (MSG1(K),K=1,3)/'AMP., STEP:'/
DATA (MJ(K),K=1,5)/'USE 100 STEPS FOR SEG! /'/
DO 34 I=1,512
34 FUNC(I)=0
IF (QTTYIN(0)) CALL MESS(MJ)
C REMOVE ABOVE LATER********
CC CALL RDNUM(AMP1)
AMP1=0
ST=0
1 IF (QTTYIN(0))CALL MESS(MSG1)
IF (QTTYIN(0))CALL SEE2(FUNC)
CALL RDNUM(AMP2)
CALL RDNUM(STEP)
IF(STEP.GT.1.)GO TO 3
AMP1=AMP2
GO TO 1
C STEP=1 AND STEP=0 ARE CONSIDERED THE SAME.
3 DIF=AMP2-AMP1
5 IT=ST
IS=STEP*5.120+.0001
STEP=IS
STPS=STEP-ST
IS=STPS
IF(IS+IT.GT.512)GO TO 6
ST=STEP
IF(ST.EQ.0)STEP=1.
DO 2 K=1,IS
CC M=K+IT
RK=K
2 FUNC(K+IT)=AMP1+DIF*RK/STPS
AMP1=AMP2
ST=STEP
CC CALL PNUM(M)
IF(STEP.LT.512)GO TO 1
CC IF(STEP.GT.513.)GO TO 6
1102 CALL MESS(A)
FUNC(1)=0.0
IF (QTTYIN(0))CALL SEE(FUNC)
RETURN
6 K=1
8 CALL RDNUM(RK)
7 FUNC(K)=RK
K=K+1
IF(K.LE.512)GO TO 8
GO TO 1102
END
SUBROUTINE SYNTH (FUNC)
C SCOPE WITH SYNTH IF FROM TTY!! AFTER 'SYNTH(F1);' TYPE 99= TO USE H,A,P,K:
C ALL OTHER NUMBERS=H,A ONLY. TYPE 999 TO END. NORMALIZATION IS AUTOMATIC.
DIMENSION FUNC(512),F(5),FMSG(10),GMSG(9)
COMMON I,XX,X,H,K,CON,XK,FAC,AMP,Y
DATA (F(I),I=1,4)/'SYNTH ARRAY FULL /'/
DATA (FMSG(I),I=1,9)/'H,A,P,K (99 FOR SHORT FORM, 999 TO FINISH)'/
DATA (GMSG(I),I=1,8)/'H,A (99 FOR LONG FORM, 999 TO FINISH)'/
FAC=360./512.
DO 15 I=1,512
15 FUNC(I)=0.0
TTY=QTTYIN(0)
C SET TTY IF TELETYPE INPUT
XX=-99
228 XX=-XX
226 IF (TTY.EQ.0) GO TO 229
IF (XX) CALL MESS(FMSG)
IF (-XX) CALL MESS(GMSG)
CALL SEE2(FUNC)
229 CALL RDNUM(H)
IF (H.EQ.99) GO TO 228
IF (H.EQ.999)GO TO 2200
16 CALL RDNUM(AMP)
IF(XX)GO TO 1016
X=0
CON=0
GO TO 2016
1016 CALL RDNUM(X)
X=X*512./360.+1.0
CALL RDNUM(CON)
2016 DO 17 J=1,512
XK=SIND(X*FAC)*AMP+CON
IF(CON.LT.100.0)GO TO 1
FUNC(J)=(XK-100.)*FUNC(J)
GO TO 2
1 FUNC(J)=FUNC(J)+XK
2 X=X+H
IF(X.LE.512.)GO TO 17
X=X-512.
17 CONTINUE
GO TO 226
2200 X=FUNC(1)
DO 19 I=2,512
H=ABS(FUNC(I))
19 IF(X.LT.H)X=H
DO 20 I=1,512
20 FUNC(I)=FUNC(I)/X
IF (TTY) CALL DPYCLR
CALL MESS(F)
RETURN
END
C *********** DUR2 1969 *********
FUNCTION DUR(P2,SPEED,CHNS)
COMMON P,ISR,NC,IDUR,ID,IP(5)
DATA IP/20000,25000,10000,50000,100000/
P=P2
ISPD=SPEED
NC=CHNS*30+.3
3 IDUR=P*10000+.5
5 IDUR=(IDUR*IP(ISPD))/1000
6 ID=IDUR/NC
7 ID=IDUR-ID*NC
IF(ID.EQ.0)GO TO 1
P=P+.0001
GO TO 3
1 DUR=P
RETURN
END